home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / DMTDEMOS / GETFIRST.DEM < prev    next >
Text File  |  1994-07-02  |  3KB  |  126 lines
  1. program GetFirstSample;
  2.  
  3.  uses crt, DMT;
  4.  
  5.  var
  6.    FileInfoBuffer : FileInfoStruct;  { The FileInfoStruct data type is defined in the DMT unit }
  7.  
  8.    FileSpec       : string;
  9.  
  10.    Fname          : string[ 12 ];
  11.  
  12.    Attributes,
  13.    Count          : byte;
  14.  
  15.    Hr,
  16.    Min,
  17.    Sec,
  18.    Month,
  19.    Day,
  20.    Year           : word;
  21.  
  22.    MatchFlag      : boolean;
  23.  
  24. procedure DecodeDate( Date    : word;
  25.  
  26.                       var
  27.                         Month,
  28.                         Day,
  29.                         Year  : word );
  30.  
  31. begin
  32.   Month := ( Date and $1E0 ) shr 5;
  33.   Day   := Date and $1F;
  34.   Year  := ( Date shr 9 ) + 1980;
  35. end;
  36.  
  37. procedure DecodeTime( Time   : word;
  38.  
  39.                       var
  40.                         Hr,
  41.                         Min,
  42.                         Sec  : word );
  43.  
  44. begin
  45.   Hr  := Time shr 11;
  46.   Min := ( Time and $7E0 ) shr 5;
  47.   Sec := ( Time and $1f ) * 2;
  48. end;
  49.  
  50. begin
  51.   Fname := '';
  52.   Color( 7, 0 );
  53.   clrscr;
  54.  
  55.   SetDTA( seg( FileInfoBuffer ), ofs( FileInfoBuffer ) );  { Call SetDTA procedure }
  56.  
  57.   writeln;
  58.   write('Enter file to be searched : ');
  59.   readln( FileSpec );
  60.  
  61.   if ( FileSpec = '' ) then
  62.     FileSpec := '*.*';
  63.  
  64.   Attributes := 255;    { Sets all available attributes }
  65.  
  66.   GetFirst( FileSpec, Attributes );   { Call GetFirst procedure }
  67.  
  68.   if ( ErrFlag ) then
  69.     begin
  70.       writeln( #7 );
  71.       writeln( ShowError( GetErrCode ) );
  72.     end
  73.   else
  74.     with FileInfoBuffer do
  75.       begin
  76.         clrscr;
  77.         writeln;
  78.         Count := 1;
  79.  
  80.         while ( FileNameExt[ Count ] <> #0 ) do
  81.           begin
  82.             Fname := Fname + FileNameExt[ Count ];
  83.             inc( Count );
  84.           end;
  85.  
  86.         writeln( 'Name             : ', Fname :-12 );
  87.         writeln( 'Size in bytes    : ', InsComma( FileSize ):-12 );
  88.  
  89.         DecodeTime( FileTime, Hr, Min, Sec );
  90.  
  91.         writeln( 'Last update time : ', Hr, ':', Min, ':', Sec );
  92.  
  93.         DecodeDate( FileDate, Month, Day, Year );
  94.  
  95.         writeln( 'Last update date : ', Month, '/', Day, '/', Year );
  96.  
  97.         write  ( 'Attributes       : ' );
  98.  
  99.         if ( FileAttrib and $20 ) = $20 then
  100.           write( 'Archive  ' );                 { Backup required }
  101.  
  102.         if ( FileAttrib and $10 ) = $10 then
  103.           write( 'Subdirectory  ' );
  104.  
  105.         if ( FileAttrib and $02 ) = $02 then
  106.           write( 'Hidden ' );
  107.  
  108.         if ( FileAttrib and $01 ) = $01 then
  109.           write( 'Read-Only  ' );
  110.  
  111.         if ( FileAttrib and $04 ) = $04 then
  112.           write( 'System  ' );
  113.  
  114.         if ( FileAttrib and $08 ) = $08 then
  115.           write( 'Volume-Label  ' );
  116.  
  117.         if ( FileAttrib = $00 ) then
  118.           write( 'Normal  ' );
  119.  
  120.         writeln;
  121.       end;
  122.   GetEnter;
  123. end.
  124.  
  125.  
  126.